bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp)
 where 
  -- Our initial event queue consists of the endpoints of our input list of segments.
  eventQueue = S.fromList (concat $ map toPoints ss)
  -- We initialize a lookup structure that maps event points to segments that interact there.
  -- Beginning and endpoints are filled, and intersection points are empty.
  bp = M.fromListWith (++) $ zip (map lep ss) (map return ss)
  ep = M.fromListWith (++) $ zip (map rep ss) (map return ss)
  xp = M.empty
  -- A convenient lookup function to use with our lookup structure.
  lookup = M.findWithDefault []
  -- work takes an event queue, a sweep line structure, and a lookup structure, and produces a list of intersection points
  -- paired with the intersecting segments.
  work eq sl lk@(bp, ep, xp)
   -- We check the event queue to see if it is non - empty. If there is an event to process, we do so.
   | Just (e@(Point x _), eq') <- S.minView eq =
    let line = Line (Point x 0) (Point x 1) -- The current sweepline.
        bs = lookup e bp -- What segments begin at this event point?
        es = lookup e ep -- What segments end at this event point?
        xs = lookup e xp -- What segments intersect at this event point?
        is = bs ++ es ++ xs
        -- sl' and then sl'': We first remove segments ending and intersecting at this point from the sweepline.
        -- We then add beginning segments and intersecting segments. This reverses the order of the x - ing segments
        -- in the sweepline.
        sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es))
        sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs))
        -- We now check for new intersections. `cmp line' is the ordering of segments w.r.t. to the sweepline.
        nxs = case bs ++ xs of
            -- If we only removed segments from the sweepline, then we look for the immediate
            -- neighbors of the removed segments in the old version of the structure. 
            [] -> let nmin = fromJust $ T.findBy (cmp line) (minimumBy (cmp line) es) sl
                       nmax = fromJust $ T.findBy (cmp line) (maximumBy (cmp line) es) sl
                   in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)]
            -- If we added segments, we look for their neighbors in the new version of the sweepline structure,
            -- and check those for intersections.
            bxs -> let nmin = fromJust $ T.findBy (cmp line) (minimumBy (cmp line) bxs) sl''
                       nmax = fromJust $ T.findBy (cmp line) (maximumBy (cmp line) bxs) sl''
                   in catMaybes [xtestl nmin, xtestr nmax]
        -- nxs' is what we get when we remove intersections that have already been found and recorded in our lookup structure.
        nxs' = filter (not . flip M.member xp . fst) nxs
        -- eq'' is the new event queue, with the new intersection points added as new event points.
        eq'' = eq' `S.union` (S.fromList (map fst nxs'))
        -- finally, lk' is the new lookup structure augmented with the new intersection points as keys.
        lk' = (bp, ep, xp `M.union` M.fromList nxs')
    -- Now, we check the number of segments associated to the current endpoint. If there's more than one, it's an intersection.
    -- We add it to the list if it exists and continue to process the rest of the events with the updated sweepline and lookup structures.
    in if length is > 1 then (e, is) : (work eq'' sl'' lk') else work eq'' sl'' lk'
   -- At some point, the eventqueue will be empty. That means we are done and there are no new intersection points to report.
   | otherwise = []


-----------------
this is a little cleaner
-----------------


--There was a bug.
bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp)
 where 
  eventQueue = S.fromList (concatMap toPoints ss)
  bp = beginPoints ss
  ep = endPoints ss
  xp = M.empty
  lookup = M.findWithDefault []
  work eq sl lk@(bp, ep, xp)
   | Just (e@(Point x _), eq') <- S.minView eq =
    let line = Line (Point x 0) (Point x 1)
        bs = lookup e bp
        es = lookup e ep
        xs = lookup e xp
        is = bs ++ es ++ xs
        sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es))
        sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs))
        nxs = case bs ++ xs of
            []  -> let (nmin, nmax) = getCandidates es sl
                   in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)]
            bxs -> let (nmin, nmax) = getCandidates bxs sl''
                   in catMaybes [xtestl nmin, xtestr nmax]
           where getCandidates ss sl = (aux minimumBy ss sl, aux maximumBy ss sl)
                 aux f ss sl = fromJust $ T.findBy (cmp line) (f (cmp line) ss) sl
        nxs' = filter (not . flip M.member xp . fst) nxs
        eq'' = eq' `S.union` S.fromList (map fst nxs')
        lk' = (bp, ep, M.unionWith ((nub .) . (++)) xp (M.fromList nxs))
    in if length is > 1 then (e, is) : work eq'' sl'' lk' else work eq'' sl'' lk'
   | otherwise = []